Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/scrtes/scrtest.frm

Visual Basic Form | 1995-05-08 | 16.8 KB | 480 lines

VERSION 2.00
Begin Form FRMSCR
   Caption         =   "Form1"
   ClientHeight    =   3420
   ClientLeft      =   1470
   ClientTop       =   1530
   ClientWidth     =   6015
   Height          =   3825
   Left            =   1410
   LinkTopic       =   "Form1"
   ScaleHeight     =   3420
   ScaleWidth      =   6015
   Top             =   1185
   Width           =   6135
   Begin CommandButton Command1
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      Height          =   495
      Left            =   2400
      TabIndex        =   2
      Top             =   2595
      Width           =   1215
   End
   Begin ListBox List1
      Height          =   1980
      Left            =   360
      TabIndex        =   1
      Top             =   240
      Width           =   5055
   End
   Begin VScrollBar VScroll1
      Height          =   1980
      LargeChange     =   10
      Left            =   5400
      Max             =   1000
      TabIndex        =   0
      Top             =   240
      Width           =   255
   End
Option Explicit
Dim MFile As database     ' Database
Dim MTable As table       ' Table
Dim Mcnt As Integer       ' General purpose loop counter
Dim MxF As String         ' First Record
Dim MxT As String         ' Top Record
Dim MxB As String         ' Bottom Record
Dim MxL As String         ' Last Record
Dim MxN As Integer        ' Number of Records
Dim MxI As Integer        ' Curr Rec Relative Index
Dim MxJ As Integer        ' Temp Index
Dim MxM As Integer        ' Movement reqd !
Dim MxO As Integer        ' Previous Movement ?
Dim MIndex As Integer     ' Current Index-Open Pointer
Dim MxKN As Integer       ' KeyPress Code
Dim MxK1 As String        ' Search Key - Character to Add-On
Dim MxK2 As String        ' Search Key - Fully Assembled
Dim MLev As Integer       ' Event Level Counter
Dim MLevC(10) As String   ' Event Identity Array
Dim MLevP(10) As String   ' Event Indent Padding
Dim MxK As String         '
Dim MxV As Integer        '
Sub Command1_Click ()
    MTable.Close
    MFile.Close
    End
End Sub
Sub Form_Load ()
    ' Enable focus on Scroll-Bar during Form-Load
    ' (prevents error due to setting size of scroll bar)
    FrmScr.Show
    'OpenDb
    ' Open the Database
    Set MFile = OpenDatabase("AFile.mdb")
    ' Open the Data Table
    Set MTable = MFile.OpenTable("ATable")
    ' Open the RecNo Index
    MTable.Index = "AIndex1"
    ' Set Index Number Var
    MIndex = 1
    ' Initialise Counters
    MxF = MTable.Bookmark      ' First Record
    MxT = MxF                  ' Top Record
    'MxC = MxF                  ' Current Record
    MxI = 1                    ' Index of Current Record
    MxN = MTable.RecordCount   ' Number of Records
    MxB = ""                   ' Bottom Record
    MxL = ""                   ' Last Record
    ' Find the last record bookmark for jump-to-End
    MxK = Str$(MxN - 1)
    MxV = Len(MxK) - 1
    MxK = Mid$("00000", 1, 5 - MxV) + Mid$(MxK, 2, MxV)
    'Debug.Print "|" + MxK + "|"
    MTable.Seek "=", MxK
    'If MTable.NoMatch Then
    '    'Debug.Print "*** No Match"
    'Else
    '    'Debug.Print "*** Found O.K."
        MxL = MTable.Bookmark
    '    ' Display the Record/Field
    '    'Debug.Print Mtable("AField")
    '    For Mcnt = 1 To 9
    '        ' Next Record
    '        MTable.MovePrevious
    '    Next Mcnt
    '    MxH = MTable.Bookmark
    '    ' Display the Record/Field
    '    'Debug.Print Mtable("AField")
    'End If
    ' Load The Event Padding
    For Mcnt = 1 To 10
        MLevP(Mcnt) = Space$(Mcnt * 3)
    Next Mcnt
    ' Load the ListBox
    GoHome
    ' Set the Previous Scroll Value to Initial Value
    Mcnt = 0
    MxO = 0
    ' Set the Scroll-Bar to A Sensible Value
    VScroll1.Max = MxN - 1
    'Debug.Cls
    'Debug.Print " "
    'Debug.Print " "
    'Debug.Print "=============================="
    'Debug.Print " "
    'Debug.Print " "
End Sub
Sub Form_Unload (Cancel As Integer)
    ' Close the Table
    MTable.Close
    ' Close the Database
    MFile.Close
End Sub
Sub GoDirect ()
    ' =================================================
    ' This code is to go directly to a relative position
    ' in the file when the User moves the Thumb.
    ' To keep the speed up it doesn't read through the
    ' file but cheats by jumping directly to a specific
    ' record, this will only work reliably on a fixed
    ' read-only file because the record-number entry in
    ' the file can only be maintained on a 'batch' basis
    ' =================================================
    'Debug.Print MLevP(MLev) + "<< Go-Direct >>"
    'Debug.Print MLevP(MLev + 1) + "== V:", VScroll1.Value, "MxO:", MxO
    ' Set the search-key to null
    MxK2 = ""
    ' Store the old comparison value
    MxO = VScroll1.Value
    ' Reset Index If Required (after a Keyed-Search)
    If MIndex = 2 Then
        MTable.Index = "AIndex1"
        MIndex = 1
    End If
    ' Formulate the numeric search key !
    MxK = Str$(MxO)
    MxV = Len(MxK) - 1
    MxK = Mid$("00000", 1, 5 - MxV) + Mid$(MxK, 2, MxV)
    ' Find The Record
    MTable.Seek "=", MxK
    If MTable.NoMatch Then
        'Debug.Print MLevP(MLev + 1) + "== No Match :", MxK
    Else
        'Debug.Print MLevP(MLev + 1) + "== Found O.K.", MxK
        MxI = 0                   ' Set the Listbox index to Top
        MxT = MTable.Bookmark     ' Store the Top bookmark
        LoadList                  ' Reload the Listbox
    End If
    'Debug.Print MLevP(MLev) + ">> Go-Direct <<"
End Sub
Sub GoDown ()
    MxI = MxI + 1              ' Increment Index Pointer
    ' ***** This triggers a Listbox Click Event ! *****
    List1.ListIndex = MxI      ' Set ListBox Index
End Sub
Sub GoEnd ()
    'Debug.Print MLevP(MLev) + "<< GoEnd >>"
    MxI = 9
    MTable.Bookmark = MxL                    ' Move To Last
    For Mcnt = 1 To 9                        ' Skip backwards 9 records
        MTable.MovePrevious                  ' (Analogous to Skip-1 in dbase)
    Next Mcnt
    MxT = MTable.Bookmark                    ' Set New Top Bookmark
    LoadList                                 ' Reload the Listbox
    'Debug.Print MLevP(MLev) + ">> GoEnd <<"
End Sub
Sub GoHome ()
    'Debug.Print MLevP(MLev) + "<< GoHome >>"
    MxT = MxF                ' Set the Top-Bookmark to First
    MxI = 0                  ' Set the Listbox Index to Top (0)
    LoadList                 ' Reload the Listbox
    'Debug.Print MLevP(MLev) + ">> GoHome <<"
End Sub
Sub GoKey ()
    'Debug.Print MLevP(MLev) + "<< Go-Key >>"
    ' Add the new character onto the end of the search key
    MxK2 = MxK2 + MxK1
    ' Set the index to Searchkey if set to Rec-Number
    If MIndex = 1 Then
        MTable.Index = "AIndex2"
        MIndex = 2
    End If
    ' Do a Seek (use >= so a perfect match is not required)
    MTable.Seek ">=", MxK2
    If MTable.NoMatch Then
        'Debug.Print MLevP(MLev + 1) + "== No Match", "|" + MxK2 + "|"
        MxK2 = ""
    Else
        If MxK2 <> Mid$(MTable("AKey"), 1, Len(MxK2)) Then
            'Debug.Print MLevP(MLev + 1) + "== Silly Match", "|" + MxK2 + "|"
            MxK2 = ""
        Else
            'Debug.Print MLevP(MLev + 1) + "== Found O.K.", "|" + MxK2 + "|" + MTable("ARecNo") + "|" + MTable("Afield") + "|"
            'Reset The Scroll Bar to the right place
            VScroll1.Value = Val(MTable("ARecNo"))
            ' Keep the old-scroll value up-to-date
            MxO = VScroll1.Value
            ' Store the Top-Record bookmark
            MxT = MTable.Bookmark
            ' Set the listbox index to top
            MxI = 0
            ' Load the ListBox
            LoadList
        End If
    End If
    'Debug.Print MLevP(MLev) + ">> Go-Key <<"
End Sub
Sub GoLotsDown ()
    ' ***** this routine should never be called *****"
    'Debug.Print MLevP(MLev) + "<< Go-Lots-Down >>"
    Debug.Print MLevP(MLev) + "!! Go-Lots-Down !!"
    'Debug.Print MLevP(MLev) + ">> Go-Lots-Down <<"
End Sub
Sub GoLotsUp ()
    ' ***** this routine should never be called *****"
    'Debug.Print MLevP(MLev) + "<< Go-Lots-Up >>"
    Debug.Print MLevP(MLev) + "!! Go-Lots-Up !!"
    'Debug.Print MLevP(MLev) + ">> Go-Lots-Up <<"
End Sub
Sub GoPageDown ()
    MxT = MxB                  ' Set Top to bottom bookmark
    MxI = 0                    ' Set Listbox index pointer
    LoadList                   ' Load the Listbox
End Sub
Sub GoPageUp1 ()
    'Debug.Print MLevP(MLev) + "<< Go-Page-Up-1 >>"
    MTable.Bookmark = MxT                    ' Move to Top
    ' Skip Backwards for 10 records (or BOF)
    MxJ = 0
    Do While (Not MTable.BOF) And (MxJ < 10)
        MTable.MovePrevious           ' Skip-1 (g)
        MxJ = MxJ + 1
    Loop
    ' Protect from Bof errors
    If MTable.BOF Then
        MxJ = MxJ - 1
        MTable.MoveNext               ' Skip (g)
    End If
    MxT = MTable.Bookmark             ' Store New Top
    MxI = MxJ - 1                     ' Set index position
    LoadList                          ' Load ListBox
    'Debug.Print MLevP(MLev) + "<< Go-Page-Up-1 >>"
End Sub
Sub GoPageUp10 ()
    ' Move to 'Top' Record
    MTable.Bookmark = MxT
    ' Skip Backwards for 10 records (or BOF)
    MxJ = 10
    Do While (Not MTable.BOF) And (MxJ > 0)
        MxJ = MxJ - 1
        MTable.MovePrevious
    Loop
    ' Prevent Bof errors
    If MTable.BOF Then
        MTable.MoveNext
    End If
    'Reset Pointers
    MxT = MTable.Bookmark
    ' Load the ListBox
    LoadList
    MxI = 0
    List1.ListIndex = 0
End Sub
Sub GoSelect ()
   ' Code to branch to other actions goes here
   ' Triggered by <CR> or <Dbl-Click>
   Debug.Print "  == Item Selected", MxI, List1.Text
End Sub
Sub GoUp ()
    MxI = MxI - 1            ' Decrement Index Pointer
    ' ***** This triggers a Listbox Click Event ! *****
    List1.ListIndex = MxI    ' Set Listbox Index
End Sub
Sub List1_Click ()
    MLev = MLev + 1
    MLevC(MLev) = "LC"
    'Debug.Print " "
    'Debug.Print MLevP(MLev) + "<< List-Click >>"
    Master
    'Debug.Print MLevP(MLev) + ">> List-Click <<"
    MLev = MLev - 1
End Sub
Sub List1_DblClick ()
    'GoSelect
    MLev = MLev + 1
    MLevC(MLev) = "LD"
    'Debug.Print " "
    'Debug.Print MLevP(MLev) + "<< List-Dbl-Click >>"
    Master
    'Debug.Print MLevP(MLev) + ">> List-Dbl-Click <<"
    MLev = MLev - 1
End Sub
Sub List1_KeyPress (KeyAscii As Integer)
    'MLev = MLev + 1
    'Debug.Print MLevP(MLev) + "<< List-KeyPress >>"
    'MxKN = KeyAscii
    'Master
    'Debug.Print MLevP(MLev) + ">> List-KeyPress <<"
    'MLev = MLev - 1
End Sub
Sub LoadList ()
    List1.Clear                              ' Clear ListBox
    MTable.Bookmark = MxT                    ' Move To Top
    MxJ = 0
    Do Until (MTable.EOF) Or (MxJ > 9)       ' Read thru records
        List1.AddItem MTable("Afield"), MxJ  ' Store to ListBox
        MTable.MoveNext                      ' Next Record (Skip)
        MxJ = MxJ + 1                        ' Increment Counter
    Loop
    ' Prevent Eof errors
    If MTable.EOF Then
        MTable.MovePrevious
    End If
    ' Store the 'Bottom' Record (for Page-downs)
    MxB = MTable.Bookmark
    ' Set Listbox Index to Pointer
    List1.ListIndex = MxI
End Sub
Sub Master ()
    ' ================================================
    ' This convoluted code is needed because keeping the
    ' Listbox and V-Scroll in Synch triggers change events
    ' and can result in an endless loop if not filtered out
    ' ================================================
    'Debug.Print MLevP(MLev + 1) + "<< Master >>"
    If MLev > 1 Then
        'Debug.Print MLevP(MLev + 2) + "== Event Ignored " + Str$(MLev) + " " + MLevC(MLev)
    Else
        'Debug.Print MLevP(MLev + 2) + "== Event " + Str$(MLev) + " " + MLevC(MLev)
        MLev = MLev + 2
        If MLevC(1) = "LC" Then            ' Listclick event
            SListClick
            'Debug.Print MLevP(MLev + 2) + "== ReFocus On VScroll"
            VScroll1.SetFocus              ' Refocus on VScroll
        ElseIf MLevC(1) = "VK" Then        ' Keypress event
            SKeyPress
        ElseIf MLevC(1) = "LD" Then        ' Dbl-Click event
            SListDbClick
            'Debug.Print MLevP(MLev + 2) + "== ReFocus On VScroll"
            VScroll1.SetFocus              ' Refocus on VScroll
        ElseIf MLevC(1) = "VC" Then        ' Scroll-Change event
            SVScrollChange
        ElseIf MLevC(1) = "VS" Then        ' Scroll-Scroll event
            SVScrollScroll
        End If
        MLev = MLev - 2
    End If
    'Debug.Print MLevP(MLev + 1) + ">> Master <<"
End Sub
Sub SKeyPress ()
    If MxKN = 13 Then            ' Detect <CR>
        'Debug.Print "  == Item Selected", List1.Text
        GoSelect
    Else
        MxK1 = UCase(Chr(MxKN))  ' Convert to Upper-case
        'Debug.Print "==", MxKN, MxK1
        GoKey
    End If
End Sub
Sub SListClick ()
    'Debug.Print MLevP(MLev + 2) + "<< SListClick >>"
    If MxI = List1.ListIndex Then
        'Debug.Print MLevP(MLev + 2) + "== No-Change =="
    Else
        'Debug.Print MLevP(MLev + 2) + "== Change ==", MxI, List1.ListIndex
        ' Keep the Scroll-bar in Synch
        ' ***** This triggers a Scroll-Change Event ! *****
        VScroll1.Value = VScroll1.Value - MxI + List1.ListIndex
        MxO = VScroll1.Value     ' Store the old comparison value
        MxI = List1.ListIndex    ' Store the index pointer
        MxK2 = ""                ' Reset the search-key to null
    End If
    'Debug.Print MLevP(MLev + 2) + ">> SListClick <<"
End Sub
Sub SListDbClick ()
    ' Listbox Double-Click Event
    GoSelect
End Sub
Sub SVScrollChange ()
    'Debug.Print MLevP(MLev) + "<< SVScrollChange >>"
    'Debug.Print MLevP(MLev + 1) + "== V:", VScroll1.Value, "MxO:", MxO
    MxK2 = ""                     ' Set the search-key to null
    If VScroll1.Value = 0 Then
        'Debug.Print MLevP(MLev + 1) + "== Go-Home"
        GoHome
    ElseIf VScroll1.Value = MxN - 1 Then
        'Debug.Print MLevP(MLev + 1) + "== Go-End"
        GoEnd
    Else
        ' Determine Net Movement
        MxM = VScroll1.Value - MxO ' Compare current value to old-value
        If MxM = 1 Then            ' Down-Requested
            'Debug.Print MLevP(MLev + 1) + "== Down-Requested"
            If MxI < 9 Then
                'Debug.Print MLevP(MLev + 1) + "== Down-Achieved"
                GoDown               ' Down-Achieved
            Else
                'Debug.Print MLevP(MLev + 1) + "== Page-Down-Instead"
                GoPageDown           ' Page-Down-Instead
            End If
        ElseIf MxM = -1 Then       ' Up-Requested
            'Debug.Print MLevP(MLev + 1) + "== Up-Requested"
            If MxI > 0 Then
                'Debug.Print MLevP(MLev + 1) + "== Up-Achieved"
                GoUp                 ' Up-Achieved
            Else
                'Debug.Print MLevP(MLev + 1) + "== Page-Up-Instead"
                GoPageUp1            ' Page-Up-Instead
            End If
        ElseIf MxM = 10 Then       ' Page-Down
            'Debug.Print MLevP(MLev + 1) + "== Page-Down-Requested"
            GoPageDown
        ElseIf MxM = -10 Then      ' Page-Up
            'Debug.Print MLevP(MLev + 1) + "== Page-Up-Requested"
            GoPageUp10
        ElseIf MxM > 10 Then       ' Lots-Down
            'Debug.Print MLevP(MLev + 1) + "== Lots-Down-Requested"
            GoLotsDown
        ElseIf MxM < -10 Then      ' Lots-Up
            'Debug.Print MLevP(MLev + 1) + "== Lots-Up-Requested"
            GoLotsUp
        ElseIf MxM < -1 Then       ' Page-Up Near-Top ?
            GoHome
        ElseIf MxM > 1 Then        ' Page-Down Near-End ?
            GoEnd
        End If
    End If
    ' Store Old Value - to compare next time around
    MxO = VScroll1.Value
    'Debug.Print MLevP(MLev) + ">> SVScrollChange <<"
End Sub
Sub SVScrollScroll ()
    ' User picked up the Thumb and moved it
    GoDirect
End Sub
Sub VScroll1_Change ()
    MLev = MLev + 1
    MLevC(MLev) = "VC"
    'Debug.Print MLevP(MLev) + "<< VScroll-Change >>"
    Master
    'Debug.Print MLevP(MLev) + ">> VScroll-Change <<"
    MLev = MLev - 1
End Sub
Sub VScroll1_KeyPress (KeyAscii As Integer)
    MLev = MLev + 1
    MLevC(MLev) = "VK"
    'Debug.Print MLevP(MLev) + "<< List-KeyPress >>"
    MxKN = KeyAscii
    Master
    'Debug.Print MLevP(MLev) + ">> List-KeyPress <<"
    MLev = MLev - 1
End Sub
Sub VScroll1_Scroll ()
    MLev = MLev + 1
    MLevC(MLev) = "VS"
    'Debug.Print MLevP(MLev) + "<< VScroll-Scroll >>"
    Master
    'Debug.Print MLevP(MLev) + ">> VScroll-Scroll <<"
    MLev = MLev - 1
End Sub